home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / Term / Complete.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  3.2 KB  |  145 lines
  1. package Term::Complete;
  2. require 5.000;
  3. require Exporter;
  4.  
  5. @ISA = qw(Exporter);
  6. @EXPORT = qw(Complete);
  7.  
  8.  
  9. =head1 NAME
  10.  
  11. Term::Complete - Perl word completion module
  12.  
  13. =head1 SYNOPSIS
  14.  
  15.     $input = complete('prompt_string', \@completion_list);
  16.     $input = complete('prompt_string', @completion_list);
  17.  
  18. =head1 DESCRIPTION
  19.  
  20. This routine provides word completion on the list of words in
  21. the array (or array ref).
  22.  
  23. The tty driver is put into raw mode using the system command
  24. C<stty raw -echo> and restored using C<stty -raw echo>.
  25.  
  26. The following command characters are defined:
  27.  
  28. =over 4
  29.  
  30. =item E<lt>tabE<gt>
  31.  
  32. Attempts word completion.
  33. Cannot be changed.
  34.  
  35. =item ^D
  36.  
  37. Prints completion list.
  38. Defined by I<$Term::Complete::complete>.
  39.  
  40. =item ^U
  41.  
  42. Erases the current input.
  43. Defined by I<$Term::Complete::kill>.
  44.  
  45. =item E<lt>delE<gt>, E<lt>bsE<gt>
  46.  
  47. Erases one character.
  48. Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>.
  49.  
  50. =back
  51.  
  52. =head1 DIAGNOSTICS
  53.  
  54. Bell sounds when word completion fails.
  55.  
  56. =head1 BUGS
  57.  
  58. The completion charater E<lt>tabE<gt> cannot be changed.
  59.  
  60. =head1 AUTHOR
  61.  
  62. Wayne Thompson
  63.  
  64. =cut
  65.  
  66. CONFIG: {
  67.     $complete = "\004";
  68.     $kill     = "\025";
  69.     $erase1 =   "\177";
  70.     $erase2 =   "\010";
  71. }
  72.  
  73. sub Complete {
  74.     my($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
  75.  
  76.     $prompt = shift;
  77.     if (ref $_[0] || $_[0] =~ /^\*/) {
  78.     @cmp_lst = sort @{$_[0]};
  79.     }
  80.     else {
  81.     @cmp_lst = sort(@_);
  82.     }
  83.  
  84.     system('stty raw -echo');
  85.     LOOP: {
  86.         print($prompt, $return);
  87.         while (($_ = getc(STDIN)) ne "\r") {
  88.             CASE: {
  89.                 $_ eq "\t" && do {
  90.                     @match = grep(/^$return/, @cmp_lst);
  91.                     $l = length($test = shift(@match));
  92.                     unless ($#match < 0) {
  93.                         foreach $cmp (@match) {
  94.                             until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
  95.                                 $l--;
  96.                             }
  97.                         }
  98.                         print("\a");
  99.                     }
  100.                     print($test = substr($test, $r, $l - $r));
  101.                     $r = length($return .= $test);
  102.                     last CASE;
  103.                 };
  104.  
  105.                 $_ eq $complete && do {
  106.                     print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
  107.                     redo LOOP;
  108.                 };
  109.  
  110.                 $_ eq $kill && do {
  111.                     if ($r) {
  112.                         undef $r;
  113.             undef $return;
  114.                         print("\r\n");
  115.                         redo LOOP;
  116.                     }
  117.                     last CASE;
  118.                 };
  119.  
  120.                 ($_ eq $erase1 || $_ eq $erase2) && do {
  121.                     if($r) {
  122.                         print("\b \b");
  123.                         chop($return);
  124.                         $r--;
  125.                     }
  126.                     last CASE;
  127.                 };
  128.  
  129.                 ord >= 32 && do {
  130.                     $return .= $_;
  131.                     $r++;
  132.                     print;
  133.                     last CASE;
  134.                 };
  135.             }
  136.         }
  137.     }
  138.     system('stty -raw echo');
  139.     print("\n");
  140.     $return;
  141. }
  142.  
  143. 1;
  144.  
  145.